Visual Basic Source Code

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / gradat1a / form1.frm (.txt) next >

Wrap

Visual Basic Form | 1999-10-03 | 23.9 KB | 683 lines

VERSION 5.00 Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX" Begin VB.Form Form1 BorderStyle = 1 'Fixed Single Caption = "Gradation 2.0 (Second Edition) - I wish this program can help you." ClientHeight = 8025 ClientLeft = 3675 ClientTop = 1290 ClientWidth = 7125 ClipControls = 0 'False Icon = "Form1.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 8025 ScaleWidth = 7125 Begin VB.Frame Frame4 Caption = "Resolution" Height = 1335 Left = 4440 TabIndex = 28 Top = 6120 Width = 2655 Begin VB.HScrollBar ResCircular2 Height = 255 Left = 840 Max = 40 Min = 21 TabIndex = 38 Top = 720 Value = 21 Width = 1695 End Begin VB.HScrollBar ResCircular Height = 255 Left = 840 Max = 15 Min = 2 TabIndex = 30 Top = 480 Value = 2 Width = 1695 End Begin VB.HScrollBar ResLinear Height = 255 Left = 840 Max = 52 Min = 23 TabIndex = 29 Top = 240 Value = 23 Width = 1695 End Begin VB.Label Label7 Caption = "Circular2" Height = 255 Left = 120 TabIndex = 37 Top = 720 Width = 855 End Begin VB.Label Label5 Caption = "Circular" Height = 255 Left = 120 TabIndex = 32 Top = 480 Width = 615 End Begin VB.Label Label4 Caption = "Linear" Height = 255 Left = 120 TabIndex = 31 Top = 240 Width = 1455 End Begin VB.Label Label6 Caption = "High Low" Height = 195 Left = 840 TabIndex = 33 Top = 960 Width = 1695 End End Begin VB.PictureBox Picture1 Height = 135 Left = 5160 ScaleHeight = 75 ScaleWidth = 1875 TabIndex = 26 Top = 7800 Width = 1935 Begin VB.Shape Shape1 BorderColor = &H00FF0000& FillColor = &H00FF0000& FillStyle = 0 'Solid Height = 375 Left = 0 Top = 0 Visible = 0 'False Width = 15 End End Begin VB.Frame Frame3 Caption = "Style" Height = 1335 Left = 2760 TabIndex = 21 Top = 6120 Width = 1575 Begin VB.OptionButton OptionCircular2 Caption = "Circular 2" Height = 255 Left = 120 TabIndex = 36 Top = 720 Width = 1335 End Begin VB.OptionButton OptionBox2 Caption = "Box 2" Height = 255 Left = 720 TabIndex = 35 Top = 960 Width = 735 End Begin VB.OptionButton OptionBox Caption = "Box" Height = 255 Left = 120 TabIndex = 34 Top = 960 Width = 975 End Begin VB.OptionButton OptionCircular Caption = "Circular" Height = 255 Left = 120 TabIndex = 23 Top = 480 Width = 975 End Begin VB.OptionButton OptionLinear Caption = "Linear" Height = 255 Left = 120 TabIndex = 22 Top = 240 Value = -1 'True Width = 975 End End Begin VB.Timer Timer1 Interval = 50 Left = 6120 Top = 7080 End Begin VB.Frame Frame2 Caption = "Sample ( Vertical Style )" Height = 1335 Left = 120 TabIndex = 19 Top = 6120 Width = 2535 Begin VB.PictureBox Sample AutoRedraw = -1 'True ClipControls = 0 'False Height = 975 Left = 120 MousePointer = 2 'Cross ScaleHeight = 915 ScaleWidth = 2235 TabIndex = 20 Top = 240 Width = 2295 End End Begin VB.Frame Frame1 Caption = "Second Color" Height = 1335 Index = 1 Left = 0 TabIndex = 10 Top = 4680 Width = 7095 Begin VB.HScrollBar SecondScroll Height = 255 Index = 0 Left = 120 Max = 255 TabIndex = 15 Top = 240 Width = 3495 End Begin VB.CommandButton SecondDialog Caption = "Dialog Box" Height = 975 Left = 6000 TabIndex = 14 Top = 240 Width = 975 End Begin VB.PictureBox SecondSample AutoRedraw = -1 'True BackColor = &H00000000& Height = 975 Left = 4920 ScaleHeight = 915 ScaleWidth = 915 TabIndex = 13 Top = 240 Width = 975 End Begin VB.HScrollBar SecondScroll Height = 255 Index = 1 Left = 120 Max = 255 TabIndex = 12 Top = 600 Width = 3495 End Begin VB.HScrollBar SecondScroll Height = 255 Index = 2 Left = 120 Max = 255 TabIndex = 11 Top = 960 Width = 3495 End Begin VB.Label SecondLabel Caption = "Red : 0" Height = 255 Index = 0 Left = 3720 TabIndex = 18 Top = 240 Width = 1095 End Begin VB.Label SecondLabel Caption = "Green : 0" Height = 255 Index = 1 Left = 3720 TabIndex = 17 Top = 600 Width = 1095 End Begin VB.Label SecondLabel Caption = "Blue : 0" Height = 255 Index = 2 Left = 3720 TabIndex = 16 Top = 960 Width = 1095 End End Begin VB.Frame Frame1 Caption = "First Color" Height = 1335 Index = 0 Left = 0 TabIndex = 1 Top = 3240 Width = 7095 Begin VB.HScrollBar FirstScroll Height = 255 Index = 2 Left = 120 Max = 255 TabIndex = 9 Top = 960 Value = 255 Width = 3495 End Begin VB.HScrollBar FirstScroll Height = 255 Index = 1 Left = 120 Max = 255 TabIndex = 8 Top = 600 Value = 255 Width = 3495 End Begin VB.PictureBox FirstSample AutoRedraw = -1 'True BackColor = &H00FFFFFF& Height = 975 Left = 4920 ScaleHeight = 915 ScaleWidth = 915 TabIndex = 7 Top = 240 Width = 975 End Begin VB.CommandButton FirstDialog Caption = "Dialog Box" Height = 975 Left = 6000 TabIndex = 6 Top = 240 Width = 975 End Begin VB.HScrollBar FirstScroll Height = 255 Index = 0 Left = 120 Max = 255 TabIndex = 2 Top = 240 Value = 255 Width = 3495 End Begin VB.Label FirstLabel Caption = "Blue : 255" Height = 255 Index = 2 Left = 3720 TabIndex = 5 Top = 960 Width = 1095 End Begin VB.Label FirstLabel Caption = "Green : 255" Height = 255 Index = 1 Left = 3720 TabIndex = 4 Top = 600 Width = 1095 End Begin VB.Label FirstLabel Caption = "Red : 255" Height = 255 Index = 0 Left = 3720 TabIndex = 3 Top = 240 Width = 1095 End End Begin VB.PictureBox MainP AutoRedraw = -1 'True BackColor = &H80000009& ClipControls = 0 'False Height = 3135 Left = 0 MousePointer = 2 'Cross ScaleHeight = 3075 ScaleWidth = 7035 TabIndex = 0 Top = 0 Width = 7095 Begin VB.Line Line1 BorderStyle = 3 'Dot DrawMode = 6 'Mask Pen Not Visible = 0 'False X1 = 1080 X2 = 4680 Y1 = 2280 Y2 = 1680 End End Begin MSComDlg.CommonDialog DialogBox Left = 6600 Top = 6960 _ExtentX = 847 _ExtentY = 847 _Version = 327680 CancelError = -1 'True End Begin VB.Label Label3 Caption = "Status Bar ..." Height = 255 Left = 5160 TabIndex = 27 Top = 7560 Width = 1935 End Begin VB.Label Label2 Caption = "Also you can choose the second color by Right Click" Height = 255 Left = 240 TabIndex = 25 Top = 7800 Width = 4815 End Begin VB.Label Label1 Caption = "*** You can choose the first color in this Sample Box by Left Click" Height = 255 Left = 120 TabIndex = 24 Top = 7560 Width = 4815 End Begin VB.Menu Menu Caption = "&Menu" Begin VB.Menu Intro Caption = "&Introducing..." Shortcut = {F2} End Begin VB.Menu ChangeColors Caption = "Change First / Second Color" End Begin VB.Menu Separator Caption = "-" End Begin VB.Menu Exit Caption = "E&xit" Shortcut = ^X End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False '******************************************* '* * '* Gradation V2.0(?) by Jongmin Baek * '* * '* Used Program : VB 5.0 * '* Date : October 3, 99 * '* !! Maybe the following code is * '* not so good. But I did my best * '* though I'm 13 years old and not so * '* good at programming. * '* * '******************************************* Dim MainD As Long Dim changed As Boolean Dim Xend, Yend As Integer Dim Xstart, Ystart As Integer Dim ColorName(2) As String Dim SetIndex As Integer Dim SecondColor As Long Dim FirstColor As Long Private Sub ChangeColors_Click() a = FirstScroll(0).Value: FirstScroll(0).Value = SecondScroll(0).Value: SecondScroll(0).Value = a b = FirstScroll(1).Value: FirstScroll(1).Value = SecondScroll(1).Value: SecondScroll(1).Value = b c = FirstScroll(2).Value: FirstScroll(2).Value = SecondScroll(2).Value: SecondScroll(2).Value = c End Sub Private Sub Exit_Click() End Sub Private Sub FirstDialog_Click() On Error GoTo 1000 DialogBox.ShowColor FT = DialogBox.Color FirstColor = FT FirstScroll(0).Value = FT - Int(FT / 256) * 256: FT = Int(FT / 256) FirstScroll(1).Value = FT - Int(FT / 256) * 256: FT = Int(FT / 256) FirstScroll(2).Value = FT 1000 Exit Sub End Sub Private Sub FirstScroll_Change(Index As Integer) SetIndex = Index FirstChange End Sub Private Sub FirstScroll_Scroll(Index As Integer) SetIndex = Index FirstChange End Sub Private Sub FirstChange() FirstLabel(SetIndex).Caption = ColorName(SetIndex) + " : " + RTrim$(Str$(FirstScroll(SetIndex).Value)) FirstColor = RGB(FirstScroll(0).Value, FirstScroll(1).Value, FirstScroll(2).Value) FirstSample.BackColor = FirstColor changed = True End Sub Private Sub Form_Load() FirstColor = RGB(255, 255, 255) ColorName(0) = "Red": ColorName(1) = "Green": ColorName(2) = "Blue" MainD = Sqr(MainP.ScaleHeight ^ 2 + MainP.ScaleWidth ^ 2) SampleGradient End Sub Private Sub Intro_Click() Form1.Enabled = False Form3.Show End Sub Private Sub MainP_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then Xstart = X: Ystart = Y Xend = X: Yend = Y Line1.Visible = True: Line1.X1 = X: Line1.Y1 = Y Line1.X2 = X: Line1.Y2 = Y MainP.Cls End If End Sub Private Sub MainP_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then Line1.X2 = X: Line1.Y2 = Y Xend = X: Yend = Y End If End Sub Private Sub MainP_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Line1.Visible = False Shape1.Visible = True Xend = X: Yend = Y If OptionLinear = True Then 'Linear Gradation is here!!! sins = Sqr((Xstart - Xend) ^ 2 + (Ystart - Yend) ^ 2) If sins = 0 Then MainP.BackColor = FirstColor: Exit Sub ExpYstart = Ystart + (Ystart - Yend) * MainD / sins ExpXstart = Xstart + (Xstart - Xend) * MainD / sins ExpYend = Yend - (Ystart - Yend) * MainD / sins ExpXend = Xend - (Xstart - Xend) * MainD / sins news = Sqr((ExpXstart - ExpXend) ^ 2 + (ExpYstart - ExpYend) ^ 2) If news <> Int(news) Then news = Int(news) + 1 StepG = ResLinear.Value / 10 'It's the speed. The more it is, the faster the speed is. But... PlusX = (ExpXend - ExpXstart) / news PlusY = (ExpYend - ExpYstart) / news sta = 0 MainP.AutoRedraw = False For i = 0 To news Step StepG Shape1.Width = i / news * Picture1.ScaleWidth NowX = ExpXstart + PlusX * i NowY = ExpYstart + PlusY * i If ((NowX > Xstart Xor NowX > Xend) Or NowX = Xstart Or NowX = Xend) And ((NowY >= Ystart Xor NowY >= Yend) Or NowY = Ystart Or NowY = Yend) Then sta = 1 Else If sta = 1 Then sta = 2 If sta = 0 Then Colors = FirstColor If sta = 2 Then Colors = SecondColor If sta = 1 Then XX = Xend - Xstart: XT = NowX - Xstart If XX = 0 Then XX = Yend - Ystart: XT = NowY - Ystart red = (XT) / (XX) * (SecondScroll(0).Value - FirstScroll(0).Value) + FirstScroll(0).Value green = (XT) / (XX) * (SecondScroll(1).Value - FirstScroll(1).Value) + FirstScroll(1).Value blue = (XT) / (XX) * (SecondScroll(2).Value - FirstScroll(2).Value) + FirstScroll(2).Value Colors = RGB(red, green, blue) End If MainP.Line (NowX - PlusY * MainD, NowY + PlusX * MainD)-(NowX + PlusY * MainD, NowY - PlusX * MainD), Colors MainP.Line (NowX - PlusY * MainD + 1, NowY + PlusX * MainD)-(NowX + PlusY * MainD + 1, NowY - PlusX * MainD), Colors MainP.Line (NowX - PlusY * MainD + 2, NowY + PlusX * MainD)-(NowX + PlusY * MainD + 2, NowY - PlusX * MainD), Colors Next i End If If OptionCircular = True Then 'Circular Gradation is here!!! Max = 0 StartToEnd = Sqr((Xstart - Xend) ^ 2 + (Ystart - Yend) ^ 2) MainP.AutoRedraw = False For i = 0 To 1 For j = 0 To 1 distance = Sqr((Ystart - MainP.ScaleHeight * i) ^ 2 + (Xstart - MainP.ScaleWidth * j) ^ 2) If distance > Max Then Max = distance Next j Next i StepG = ResCircular.Value / 100 For i = 0 To 360 Step StepG Shape1.Width = i / 360 * Picture1.ScaleWidth If i > StartToEnd Then Colors = SecondColor Else red = i / 360 * (SecondScroll(0).Value - FirstScroll(0).Value) + FirstScroll(0).Value green = i / 360 * (SecondScroll(1).Value - FirstScroll(1).Value) + FirstScroll(1).Value blue = i / 360 * (SecondScroll(2).Value - FirstScroll(2).Value) + FirstScroll(2).Value Colors = RGB(red, green, blue) End If X2 = Xstart + Sin(i * 3.141592654 / 180) * Max Y2 = Ystart + Cos(i * 3.141592654 / 180) * Max MainP.Line (Xstart, Ystart)-(X2, Y2), Colors MainP.Line (Xstart, Ystart)-(X2 + 1, Y2), Colors MainP.Line (Xstart, Ystart)-(X2 + 2, Y2), Colors Next i End If If OptionBox.Value = True Or OptionBox2.Value = True Then 'Box Gradation Code is here!!! MainP.AutoRedraw = False MainP.BackColor = IIf(OptionBox.Value = False, FirstColor, SecondColor) T1 = Xstart - Abs(Xend - Xstart): T2 = Xstart + Abs(Xend - Xstart) R1 = Ystart - Abs(Yend - Ystart): R2 = Ystart + Abs(Yend - Ystart) If T2 - T1 > R2 - R1 Then O = R2 - R1 Else O = T2 - T1 StepG = 1: H = O / 10 If OptionBox2.Value = True Then For i = 0 To H Step StepG red = i / H * (FirstScroll(0).Value - SecondScroll(0).Value) + SecondScroll(0).Value green = i / H * (FirstScroll(1).Value - SecondScroll(1).Value) + SecondScroll(1).Value blue = i / H * (FirstScroll(2).Value - SecondScroll(2).Value) + SecondScroll(2).Value Colors = RGB(red, green, blue) X1 = T1 + i: X2 = T2 - i: Y1 = R1 + i: Y2 = R2 - i If X1 > X2 Then X1 = (X1 + X2) / 2: X2 = X1 If Y1 > Y2 Then Y1 = (Y1 + Y2) / 2: Y2 = Y1 MainP.Line (T1 - i, R1 - i)-(T2 + i, R2 + i), Colors, B Next i End If StepG = 1: H = O * 2 / 5 For i = 0 To H Step StepG Shape1.Width = i / H * Picture1.ScaleWidth red = i / H * (FirstScroll(0).Value - SecondScroll(0).Value) + SecondScroll(0).Value green = i / H * (FirstScroll(1).Value - SecondScroll(1).Value) + SecondScroll(1).Value blue = i / H * (FirstScroll(2).Value - SecondScroll(2).Value) + SecondScroll(2).Value Colors = RGB(red, green, blue) X1 = T1 + i: X2 = T2 - i: Y1 = R1 + i: Y2 = R2 - i If X1 > X2 Then X1 = (X1 + X2) / 2: X2 = X1 If Y1 > Y2 Then Y1 = (Y1 + Y2) / 2: Y2 = Y1 MainP.Line (T1 + i, R1 + i)-(T2 - i, R2 - i), Colors, B Next i X1 = T1 + i: X2 = T2 - i: Y1 = R1 + i: Y2 = R2 - i If X1 > X2 Then X1 = (X1 + X2) / 2: X2 = X1 If Y1 > Y2 Then Y1 = (Y1 + Y2) / 2: Y2 = Y1 MainP.Line (T1 + i, R1 + i)-(T2 - i, R2 - i), Colors, BF End If If OptionCircular2.Value = True Then 'Here is OptionCircular2 Code!!! MainP.AutoRedraw = False STE = Sqr((Xstart - Xend) ^ 2 + (Ystart - Yend) ^ 2) StepG = ResCircular2.Value / 10 MainP.BackColor = SecondColor For i = 0 To STE Step StepG Shape1.Width = i / STE * Picture1.ScaleWidth red = i / STE * (SecondScroll(0).Value - FirstScroll(0).Value) + FirstScroll(0).Value green = i / STE * (SecondScroll(1).Value - FirstScroll(1).Value) + FirstScroll(1).Value blue = i / STE * (SecondScroll(2).Value - FirstScroll(2).Value) + FirstScroll(2).Value Colors = RGB(red, green, blue) MainP.Circle (Xstart, Ystart), i, RGB(red, green, blue) MainP.Circle (Xstart + 1, Ystart), i, RGB(red, green, blue) MainP.Circle (Xstart - 1, Ystart), i, RGB(red, green, blue) Next i End If MainP.AutoRedraw = True Shape1.Visible = False End Sub Private Sub Sample_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Colors = Sample.Point(X, Y) MM = Colors value1 = Colors - Int(Colors / 256) * 256: Colors = Int(Colors / 256) value2 = Colors - Int(Colors / 256) * 256: Colors = Int(Colors / 256) value3 = Colors If Button = 1 Then FirstScroll(0).Value = value1 FirstScroll(1).Value = value2 FirstScroll(2).Value = value3 If Button = 2 Then SecondScroll(0).Value = value1 SecondScroll(1).Value = value2 SecondScroll(2).Value = value3 End If End If End Sub Private Sub SecondDialog_Click() On Error GoTo 1000 DialogBox.ShowColor ST = DialogBox.Color SecondColor = ST SecondScroll(0).Value = ST - Int(ST / 256) * 256: ST = Int(ST / 256) SecondScroll(1).Value = ST - Int(ST / 256) * 256: ST = Int(ST / 256) SecondScroll(2).Value = ST 1000 Exit Sub End Sub Private Sub SecondScroll_Change(Index As Integer) SetIndex = Index SecondChange End Sub Private Sub SecondScroll_Scroll(Index As Integer) SetIndex = Index SecondChange End Sub Private Sub SecondChange() SecondLabel(SetIndex) = ColorName(SetIndex) + " : " + RTrim$(Str$(SecondScroll(SetIndex).Value)) SecondColor = RGB(SecondScroll(0).Value, SecondScroll(1).Value, SecondScroll(2).Value) SecondSample.BackColor = SecondColor changed = True End Sub Private Sub SampleGradient() v1 = FirstScroll(0).Value v2 = FirstScroll(1).Value v3 = FirstScroll(2).Value e1 = SecondScroll(0).Value e2 = SecondScroll(1).Value e3 = SecondScroll(2).Value g = 10 For i = 0 To Sample.ScaleWidth Step g T1 = v1 + (e1 - v1) / Sample.ScaleWidth * i T2 = v2 + (e2 - v2) / Sample.ScaleWidth * i t3 = v3 + (e3 - v3) / Sample.ScaleWidth * i 10 Sample.Line (i, 0)-(i + g - 1, Sample.ScaleHeight), RGB(T1, T2, t3), BF Next i changed = False End Sub Private Sub Timer1_Timer() If changed = True Then SampleGradient End Sub